home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE10 / FILES / STRM5U.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-29  |  3.8 KB  |  180 lines
  1. unit Strm5u;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TPointList = class(TComponent)
  11.   protected
  12. {$ifdef Windows}
  13.     procedure WriteComponents(Writer: TWriter); override;
  14. {$else}
  15.     procedure GetChildren(Proc: TGetChildProc); override;
  16. {$endif}
  17.   end;
  18.  
  19.   TPointData = class(TComponent)
  20.   private
  21.     FX, FY: Word;
  22. {$ifdef Windows}
  23.   protected
  24.     function HasParent: Boolean; override;
  25. {$endif}
  26.   public
  27.     constructor CreateXY(AOwner: TComponent; AX, AY: Word);
  28.     procedure SwapXY;
  29.   published
  30.     property X: Word read FX write FX default 0;
  31.     property Y: Word read FY write FY default 0;
  32.   end;
  33.  
  34.   TForm1 = class(TForm)
  35.     PaintBox1: TPaintBox;
  36.     Bevel1: TBevel;
  37.     MakeBtn: TButton;
  38.     SaveBtn: TButton;
  39.     LoadBtn: TButton;
  40.     SwapBtn: TButton;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure PaintBox1Paint(Sender: TObject);
  43.     procedure MakeBtnClick(Sender: TObject);
  44.     procedure SaveBtnClick(Sender: TObject);
  45.     procedure LoadBtnClick(Sender: TObject);
  46.     procedure SwapBtnClick(Sender: TObject);
  47.   private
  48.     PointList: TPointList;
  49.     procedure ClearPoints;
  50.   end;
  51.  
  52. var
  53.   Form1: TForm1;
  54.   Pt: TPointData;
  55.   Loop: Integer;
  56.  
  57. const
  58.   DataFile = 'POINTS4.DAT';
  59.  
  60. implementation
  61.  
  62. {$R *.DFM}
  63.  
  64. {$ifdef Windows}
  65. {$R Points.R16}
  66. procedure TPointList.WriteComponents(Writer: TWriter);
  67. var
  68.   Loop: Integer;
  69. begin
  70.   { inherited version does nothing - no need to call it }
  71.   for Loop := 0 to ComponentCount - 1 do
  72.     Writer.WriteComponent(Components[Loop]);
  73. end;
  74. {$else}
  75. {$R Points.R32}
  76. procedure TPointList.GetChildren(Proc: TGetChildProc);
  77. var
  78.   Loop: Integer;
  79. begin
  80.   { inherited version does nothing - no need to call it }
  81.   for Loop := 0 to ComponentCount - 1 do
  82.     Proc(Components[Loop]);
  83. end;
  84. {$endif}
  85.  
  86. constructor TPointData.CreateXY(AOwner: TComponent; AX, AY: Word);
  87. begin
  88.   inherited Create(AOwner);
  89.   FX := AX;
  90.   FY := AY;
  91. end;
  92.  
  93. {$ifdef Windows}
  94. function TPointData.HasParent: Boolean;
  95. begin
  96.   Result := True;
  97. end;
  98. {$endif}
  99.  
  100. procedure TPointData.SwapXY;
  101. begin
  102.   Tag := FX;
  103.   FX := FY;
  104.   FY := Tag;
  105. end;
  106.  
  107. procedure TForm1.ClearPoints;
  108. begin
  109.   PointList.DestroyComponents;
  110. end;
  111.  
  112. procedure TForm1.FormCreate(Sender: TObject);
  113. begin
  114.   PointList := ReadComponentRes(TPointList.ClassName, nil) as TPointList;
  115. end;
  116.  
  117. procedure TForm1.PaintBox1Paint(Sender: TObject);
  118. begin
  119.   for Loop := 0 to PointList.ComponentCount - 1 do
  120.   begin
  121.     Pt := PointList.Components[Loop] as TPointData;
  122.     if Loop = 0 then
  123.       PaintBox1.Canvas.MoveTo(Pt.X, Pt.Y)
  124.     else
  125.       PaintBox1.Canvas.LineTo(Pt.X, Pt.Y)
  126.   end;
  127. end;
  128.  
  129. procedure TForm1.MakeBtnClick(Sender: TObject);
  130. begin
  131.   ClearPoints;
  132.   for Loop := 1 to {Random(40) + 1}20 do
  133.   begin
  134.     Pt := TPointData.CreateXY(PointList,
  135.             Random(PaintBox1.Width),
  136.             Random(PaintBox1.Height));
  137.     PaintBox1.Invalidate;
  138.   end;
  139. end;
  140.  
  141. procedure TForm1.SaveBtnClick(Sender: TObject);
  142. var
  143.   Stream: TFileStream;
  144. begin
  145.   Stream := TFileStream.Create(DataFile, fmCreate);
  146.   try
  147.     Stream.WriteComponent(PointList);
  148.   finally
  149.     Stream.Free;
  150.   end;
  151.   ClearPoints;
  152.   PaintBox1.Invalidate;
  153. end;
  154.  
  155. procedure TForm1.LoadBtnClick(Sender: TObject);
  156. var
  157.   Stream: TFileStream;
  158. begin
  159.   ClearPoints;
  160.   Stream := TFileStream.Create(DataFile, fmOpenRead or fmShareDenyWrite);
  161.   try
  162.     Stream.ReadComponent(PointList);
  163.   finally
  164.     Stream.Free;
  165.   end;
  166.   PaintBox1.Invalidate;
  167. end;
  168.  
  169. procedure TForm1.SwapBtnClick(Sender: TObject);
  170. begin
  171.   for Loop := 0 to PointList.ComponentCount - 1 do
  172.     (PointList.Components[Loop] as TPointData).SwapXY;
  173.   PaintBox1.Invalidate;
  174. end;
  175.  
  176. initialization
  177.   Randomize;
  178.   RegisterClasses([TPointList, TPointData]);
  179. end.
  180.